home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 26 / Cream of the Crop 26.iso / program / p063b9s.zip / UNIT / AREAMISC.PAS < prev    next >
Pascal/Delphi Source File  |  1997-03-02  |  18KB  |  619 lines
  1. UNIT AreaMisc;
  2. {╔══════════════════════════════════════════════════════════════════════════╗}
  3. {║ Various areamanager routines                  Last changed: 02.03.96  SA ║}
  4. {║                                                                          ║}
  5. {║                         (C) Copyright 1989-97 by                         ║}
  6. {║       Dan Wulff, Jens Sandalgaard, Steen Christensen & S¢ren Ager        ║}
  7. {║                                                                          ║}
  8. {║ This source may not be given to anybody, without the written permission  ║}
  9. {║ from The Portal Team.                                                    ║}
  10. {╚══════════════════════════════════════════════════════════════════════════╝}
  11. {$I POPDEFS.INC}
  12.  
  13. INTERFACE
  14.  
  15. USES Use32, Dos, PoPTypes, Globals,
  16.      OpString;
  17.  
  18. CONST
  19.   TableSize = 2000;
  20.  
  21. TYPE
  22.   FilesRec   =RECORD
  23.                 Time,
  24.                 size : LongInt;
  25.                 Name : S12;
  26.               END;
  27.   FilesTab   =ARRAY[1..TableSize] OF FilesRec;
  28.   FilesBBSRec=RECORD
  29.                 Tekst : StringPtr;
  30.                 Mark  : Boolean;
  31.               END;
  32.   FilesBBSTab=ARRAY[1..TableSize] OF ^FilesBBSRec;
  33. VAR
  34.  FdbPath : PathStr;
  35. PROCEDURE SorterFiles(VAR Files: FilesTab; Num: Word);
  36. FUNCTION  ReadFileAreas(VAR Area: AreaTabPtr): Integer;
  37. PROCEDURE DisposeFileAreas(VAR Area: AreaTabPtr; Num: Integer);
  38. PROCEDURE AddFilesBBSLine(VAR FilesBBSNum: Word; VAR FilesBBS: FilesBBSTab; CONST s: STRING);
  39. FUNCTION  ReadFilesInArea(CONST FPath:PathStr;
  40.                           Mode : Byte;  { Mode: 1=tekst 2=files 4=List file }
  41.                           VAR Files:FilesTab;
  42.                           VAR FilesBBS:FilesBBSTab;
  43.                           VAR FilesBBSNum,NumFiles:Word;
  44.                           AreaNumber: Word) : Boolean;
  45. PROCEDURE DeAllocateFiles(VAR FilesBBS: FilesBBSTab; VAR FilesBBSNum:Word);
  46. PROCEDURE WriteCurrentFilesBBS(CONST FPath: PathStr; FilesBBSNum: Word;
  47.                                VAR FilesBBS:FilesBBSTab; Visible: Boolean);
  48. FUNCTION  AdoptOrphans(Silent, Show: Boolean; VAR FilesBBS: FilesBBSTab;
  49.                        VAR Files: FilesTab; VAR NumFiles,FilesBBSNum:Word; CONST Comment: S128) : Boolean;
  50. FUNCTION  GetFileInfo(CONST FileName: String; VAR Files: FilesTab; NumFiles:Word) : Integer;
  51.  
  52. FUNCTION  HasFileName(CONST s: STRING): Boolean;
  53.  
  54. PROCEDURE AddDlC(VAR s: STRING);
  55. PROCEDURE DelDlC(VAR s: STRING);
  56. PROCEDURE IncDlC(VAR s: STRING; Count: Byte);
  57. PROCEDURE ZeroDlC(VAR s: STRING);
  58. FUNCTION  GetDlC(s: STRING): LongInt;
  59. FUNCTION  WritableFile(CONST FName:PathStr):BOOLEAN;
  60.  
  61. IMPLEMENTATION
  62.  
  63. USES OpCrt, OpRoot, OpWindow, OpDos,
  64.      StrUtil, OproUtil, NetFile, Display, Opus_173, LogFile, Util, FileUtil,
  65.      Input, BBSDef;
  66.  
  67.   FUNCTION  WritableFile(CONST FName:PathStr):BOOLEAN;
  68.   VAR
  69.     dc:DiskClass;
  70.     ch,sd:CHAR;
  71.     sr:SearchRec;
  72.   BEGIN
  73.     WritableFile:=FALSE;
  74.     ch:=UpCase(FName[1]);
  75.     dc:=GetDiskClass(ch,sd);
  76.     IF dc IN [CDRomDisk] THEN EXIT;
  77.     FINDFIRST(FName,AnyFile,sr);
  78.     IF NOT ((DOSERROR=0) AND (sr.Attr AND ReadOnly<>0)) THEN
  79.       WritableFile:=TRUE;
  80.     FindClose(sr);
  81.   END;
  82.  
  83.   FUNCTION GetFileInfo(CONST FileName : String; VAR Files:FilesTab; NumFiles:Word) : Integer;
  84.   VAR
  85.     top,bund,test : Integer;
  86.     s: STRING;
  87.   BEGIN
  88.     top:=NumFiles;
  89.     bund:=1;
  90.     s:=StUpCase(Copy(FileName,1,pos(' ',FileName+' ')-1));
  91.     IF s<>'' THEN
  92.     BEGIN
  93.       REPEAT
  94.         test:=(top+bund) DIV 2;
  95.         IF Files[test].Name>s THEN top:=test-1 ELSE
  96.           IF Files[test].Name<s THEN bund:=test+1;
  97.       UNTIL (top<bund) OR (s=Files[test].Name);
  98. {      Test:=(Top+Bund) DIV 2;}
  99.       IF Files[test].Name<>s THEN test:=0;
  100.     END ELSE test:=0;
  101.     GetFileInfo:=test;
  102.   END;
  103.  
  104.   FUNCTION AdoptOrphans(Silent, Show: Boolean; VAR FilesBBS:FilesBBSTab;
  105.                         VAR Files: FilesTab; VAR NumFiles, FilesBBSNum: Word; CONST Comment:S128) : Boolean;
  106.   TYPE
  107.     TableType=ARRAY[1..TableSize] OF Boolean;
  108.   VAR
  109.     found : ^TableType;
  110.     i,num : Integer;
  111.   BEGIN
  112.     AdoptOrphans:=FALSE;
  113.     IF Silent OR Confirm('Adopt ALL orphans in this area >','Y',9) THEN
  114.     BEGIN
  115.       New(Found);
  116.       FillChar(found^,SizeOf(TableType),#0);
  117.       FOR i:=1 TO FilesBBSNum DO
  118.       BEGIN
  119.         num:=GetFileInfo(FilesBBS[i]^.Tekst^,Files,NumFiles);
  120.         IF num>0 THEN found^[num]:=True;
  121.       END;
  122.       num:=0;
  123.       FOR i:=1 TO NumFiles DO
  124.         IF NOT found^[i] THEN
  125.         BEGIN
  126.           AddFilesBBSLine(FilesBBSNum,FilesBBS,PAD(Files[i].Name,13)+Comment);
  127.           Inc(num);
  128.           AdoptOrphans:=TRUE;
  129.         END;
  130.       Dispose(Found);
  131.       IF NOT Silent THEN
  132.         UserInformation(8,Long2Str(num)+' file(s) adopted',3,1);
  133.     END;
  134.   END;
  135.  
  136.   PROCEDURE WriteCurrentFilesBBS(CONST FPath: PathStr;
  137.                                  FilesBBSNum: Word;
  138.                                  VAR FilesBBS: FilesBBSTab;
  139.                                  Visible: Boolean);
  140.   VAR
  141.     f   : TBufTextFile;
  142.     i   : Word;
  143.     io  : Integer;
  144.     tn  : PathStr;
  145.     s   : STRING;
  146.   BEGIN
  147.     IF Cfg.BBS.BBSType=btOpus170 THEN Exit;
  148.     IF WritableFile(FPath) THEN
  149.     BEGIN
  150.       tn:=ForceExtension(FPath,'$$$');
  151.       IF f.Init(tn, SCreate, Max64k(MaxAvail-1024)) THEN Io:=0 ELSE Io:=-1;
  152.       IF Io=0 THEN
  153.       BEGIN
  154.         FOR i:=1 TO FilesBBSNum DO
  155.         BEGIN
  156.           s:=TrimTrail(FilesBBS[i]^.Tekst^);
  157.           f.WriteLn(s);
  158.           Io:=f.GetStatus;
  159.           IF Io<>0 THEN Break;
  160.         END;
  161.         f.Close;
  162.         IF Io=0 THEN Io:=f.GetStatus;
  163.         f.Done;
  164.         IF Io=0 THEN
  165.         BEGIN
  166.           DeleteFile(ForceExtension(tn,'BAK'));
  167.           IF (ExistFile(FPath)) AND (NOT RenameFile(FPath,ForceExtension(tn,'BAK'))) THEN
  168.             io:=1
  169.           ELSE
  170.             IF NOT RenameFile(tn, FPath) THEN io:=1;
  171.         END;
  172.       END;
  173.       IF Io<>0 THEN
  174.       BEGIN
  175.         IF Visible THEN AskError(8,'Error writing FILES.BBS - keeping old version',3)
  176.                    ELSE AddLog('!','Error writing '+FPath);
  177.       END;
  178.     END;
  179.   END;
  180.  
  181.  
  182.   PROCEDURE DeAllocateFiles(VAR FilesBBS:FilesBBSTab; VAR FilesBBSNum:Word);
  183.   VAR
  184.     i : Integer;
  185.   BEGIN
  186.     FOR i:=FilesBBSNum DOWNTO 1 DO
  187.     BEGIN
  188.       DisposeString(FilesBBS[i]^.Tekst);
  189.       Dispose(FilesBBS[i]);
  190.     END;
  191.     FilesBBSNum:=0;
  192.   END;
  193.  
  194.   PROCEDURE AddFilesBBSLine(VAR FilesBBSNum: Word; VAR FilesBBS: FilesBBSTab; CONST s: STRING);
  195.   BEGIN
  196.     Inc(FilesBBSNum);
  197.     New(FilesBBS[FilesBBSNum]);
  198.     FilesBBS[FilesBBSNum]^.Tekst:=StringToHeap(s);
  199.     FilesBBS[FilesBBSNum]^.Mark:=False;
  200.   END;
  201.  
  202.   PROCEDURE SorterFiles(VAR Files: FilesTab; Num: Word);
  203.  
  204.     PROCEDURE sorter(l,r: Integer);
  205.     VAR
  206.       i,j : Integer;
  207.       x   : S12;
  208.       t   : FilesRec;
  209.     BEGIN
  210.       i:=l; j:=r;
  211.       x:=Files[(l+r) DIV 2].Name;
  212.       REPEAT
  213.         WHILE Files[i].Name<x DO
  214.           Inc(i);
  215.         WHILE x<Files[j].Name DO
  216.           Dec(j);
  217.         IF i<=j THEN
  218.         BEGIN
  219.           t:=Files[j];
  220.           Files[j]:=Files[i];
  221.           Files[i]:=t;
  222.           Inc(i); Dec(j);
  223.         END;
  224.       UNTIL i>j;
  225.       IF l<j THEN sorter(l,j);
  226.       IF i<r THEN sorter(i,r);
  227.     END;
  228.  
  229.   BEGIN
  230.     IF Num>1 THEN Sorter(1,Num);
  231.   END;
  232.  
  233.   FUNCTION ReadFilesInArea(CONST FPath:PathStr;
  234.                            Mode : Byte;
  235.                            VAR Files:FilesTab;
  236.                            VAR FilesBBS:FilesBBSTab;
  237.                            VAR FilesBBSNum,NumFiles:Word;
  238.                            AreaNumber: Word) : Boolean;
  239.   LABEL
  240.     Slut;
  241.   VAR
  242.     io     : Integer;
  243.     sr     : SEARCHREC;
  244.     Offset : LongInt;
  245.     tf     : TBufTextFile;
  246.     btf    : TBufTextFile;
  247.     f      : TNetFile;
  248.     WaitWin   : PWait;
  249.     s      : String;
  250.     FilesBBSRec : FilesBBSType;
  251.   BEGIN
  252.     ReadFilesInArea:=FALSE;
  253.     Io:=0;
  254.     IF Mode AND 1<>0 THEN
  255.     BEGIN
  256.       CLRSCR;
  257.       New(WaitWin, Init(5, 3, 'Scanning for files'));
  258.     END ELSE
  259.       WaitWin:=NIL;
  260.     IF Mode AND 2<>0 THEN
  261.     BEGIN
  262.       NumFiles:=0;
  263.       FINDFIRST('*.*',archive,sr);
  264.       WHILE DOSERROR=0 DO
  265.       BEGIN
  266.         s:=Copy(sr.Name,1,7);
  267.         IF (s<>'FILES.B') AND (s<>'DIR.BBS') AND (s<>'DIR.BAK') AND
  268.            (s<>'FILES.D') AND (s<>'FILES.I') AND ((Cfg.BBS.BBSType<>btOpus170) OR (sr.Name<>'LFILE.DAT')) THEN
  269.         BEGIN
  270.           IF NumFiles<TableSize THEN
  271.           BEGIN
  272.             Inc(NumFiles);
  273.             Move(sr.Time,Files[NumFiles],21);
  274.           END ELSE
  275.           BEGIN
  276.             AddLog('!','Too many files in area');
  277.             FindClose(sr);
  278.             GOTO Slut;
  279.           END;
  280.         END;
  281.         IF WaitWin<>NIL THEN WaitWin^.Animate;
  282.         FindNext(sr);
  283.       END;
  284.       FindClose(sr);
  285.       sorterfiles(files,NumFiles);
  286.     END;
  287.     IF Mode AND 4<>0 THEN
  288.     BEGIN
  289.       DeAllocateFiles(FilesBBS,FilesBBSNum);
  290.       InOutRes:=0;
  291.       IF Mode AND 1<>0 THEN WaitWin^.Text:='Reading FILES.BBS';
  292.       IF Cfg.BBS.BBSType=btOpus170 THEN
  293.       BEGIN
  294.         IF FindAreaByNumber(Cfg.BBS.Path, AreaNumber, Offset) THEN
  295.         BEGIN
  296.           IF btf.Init(Cfg.BBS.Path+'FILESBBS.DAT', SOpenRead+ShareDenyNone, 4096) THEN
  297.           BEGIN
  298.             btf.Seek(Offset); Offset:=0;
  299.             REPEAT
  300.               ReadOneFilesBbsLine(btf, FilesBBSRec);
  301.               IF FilesBBSRec.Area_Number=AreaNumber THEN
  302.               BEGIN
  303.                 IF FilesBBSRec.Nxt_Key<>0 THEN Offset:=FilesBBSRec.Nxt_Key;
  304.                 IF (FilesBBSRec.AFlag AND $80)=0 THEN  { Deleted }
  305.                 BEGIN
  306.                   IF (FilesBBSRec.AFlag AND 2)<>0 THEN   { Comment }
  307.                     s:=FilesBBSRec.Description
  308.                   ELSE
  309.                     IF (FilesBBSRec.AFlag AND $20)=0 THEN   {StarName}
  310.                       s:=Pad(FilesBBSRec.Name,13)+'['+Long2Str(FilesBBSRec.Down_Cntr)+'] '+FilesBBSRec.Description;
  311.                 END;
  312.                 IF (MaxAvail<5120) OR (FilesBBSNum>=TableSize) THEN
  313.                 BEGIN
  314.                   btf.Done;
  315.                   AddLog('!','Not enough memory to read all files in area: '+Long2Str(AreaNumber));
  316.                   GOTO Slut;
  317.                 END;
  318.                 AddFilesBBSLine(FilesBBSNum,FilesBBS,s);
  319.               END ELSE
  320.                 IF Offset<>0 THEN
  321.                 BEGIN
  322.                   btf.Seek(Offset);
  323.                   Offset:=0;
  324.                   FilesBBSRec.Area_Number:=AreaNumber;
  325.                 END;
  326.               IF WaitWin<>NIL THEN WaitWin^.Animate;
  327.             UNTIL (btf.EoF) OR (FilesBBSRec.Area_Number<>AreaNumber);
  328.             btf.Done;
  329.           END;
  330.         END;
  331.       END ELSE
  332.       BEGIN
  333.         IF tf.Init(FPath, SOpenRead+ShareDenyW, 2048) THEN
  334.         BEGIN
  335.           WHILE NOT tf.EoF DO
  336.           BEGIN
  337.             tf.ReadLn(s);
  338.             IF (MaxAvail<5120) OR (FilesBBSNum>=TableSize) THEN
  339.             BEGIN
  340.               tf.Done;
  341.               IF AreaNumber<>0 THEN s:=Long2Str(AreaNumber) ELSE s:=FPath;
  342.               AddLog('!','Not enough memory to read FILES.BBS in area: '+s);
  343.               GOTO Slut;
  344.             END;
  345.             AddFilesBBSLine(FilesBBSNum,FilesBBS,s);
  346.             IF WaitWin<>NIL THEN WaitWin^.Animate;
  347.           END;
  348.           tf.Done;
  349.         END;
  350.       END;
  351.     END;
  352.     ReadFilesInArea:=(Io<>5);
  353. Slut:
  354.     IF Mode AND 1<>0 THEN Dispose(WaitWin, Done);
  355.   END;
  356.  
  357. PROCEDURE DisposeFileAreas(VAR Area:AreaTabPtr; Num:Integer);
  358. VAR
  359.   i:Integer;
  360. BEGIN
  361.   FOR i:=Num DOWNTO 1 DO
  362.   BEGIN
  363.     DisposeString(Area^[i]^.FPath);
  364.     DisposeString(Area^[i]^.Path);
  365.     DisposeString(Area^[i]^.Title);
  366.     DisposeString(Area^[i]^.Tag);
  367.     Dispose(Area^[i]);
  368.   END;
  369. END;
  370.  
  371. FUNCTION ReadFileAreas(VAR Area:AreaTabPtr): Integer;
  372. TYPE
  373.   FlagType       = array[1..4] of Byte;
  374. VAR
  375.   WaitWin         : PWait;
  376.   num, io      : Integer;
  377.   RaAreaNUM    : Word;
  378.   f, f2        : TNetFile;
  379.   fa           : PFileStruct;
  380.   Buf          : POINTER;
  381.   NameStr,
  382.   FilePathStr,
  383.   ListPathStr,
  384.   TagStr       : STRING;
  385.   First, Last,
  386.   NameId, FPID,
  387.   LPID, TagID  : BYTE;
  388.  
  389.   PROCEDURE AddToList(CONST ATitle,Path,FPath:S80; CONST Tag:S10);
  390.   VAR
  391.     ATag:S10;
  392.     AFPath,APath:PathStr;
  393.   BEGIN
  394.     IF Num<MaxAreas THEN
  395.     BEGIN
  396.       ATag:=Tag;
  397.       APath:=Path;
  398.       AFPath:=FPath;
  399.       INC(Num);
  400.       IF ATag='' THEN STR(Num:3,ATag);
  401.       APath:=StUpCase(AddBackSlash(APath));
  402.       IF AFPath='' THEN AFPath:=APath+'FILES.BBS';
  403.       New(Area^[Num]);
  404.       WITH Area^[Num]^ DO
  405.       BEGIN
  406.         Tag:=StringToHeap(ATag);
  407.         Title:=StringToHeap(ATitle);
  408.         Path:=StringToHeap(APath);
  409.         FPath:=StringToHeap(AFPath);
  410.       END;
  411.     END;
  412.   END;
  413.  
  414.   PROCEDURE ReadGenericFileAreas;
  415.   VAR
  416.     f : TNetFile;
  417.     s:STRING;
  418.     Tag:S10;
  419.     LP,FP:PathStr;
  420.     Title:S80;
  421.   BEGIN
  422.     IF f.Open(StartPath+PoPGenericAreaFile, 1, False) THEN
  423.     BEGIN
  424.       WHILE NOT f.EoF DO
  425.       BEGIN
  426.         f.ReadLine(s);
  427.         Tag:='';
  428.         Title:=NextWord(' ',s);
  429.         Replace(Title,'_',' ',0);
  430.         FP:=AddBackSlash(NextWord(' ',s));
  431.         LP:=NextWord(' ',s);
  432.         AddToList(Title,FP,LP,'');
  433.         WaitWin^.Animate;
  434.       END;
  435.       f.Close;
  436.     END;
  437.   END;
  438.  
  439. BEGIN
  440.   io:=0;
  441.   Num:=0;
  442.   New(WaitWin, Init(7, 3, 'Reading file areas........'));
  443.   IF ExistFile(StartPath+PoPGenericAreaFile) THEN
  444.     ReadGenericFileAreas
  445.   ELSE
  446.   BEGIN
  447.     GetFileStruct(fa,'FILES');
  448.     FdbPath := fa^.FDBPath;
  449.     NameID:=FindField(fa,bdName);
  450.     FPID:=FindField(fa,bdFilePath);
  451.     LPID:=FindField(fa,bdListPath);
  452.     TagID:=FindField(fa,bdAreaTag);
  453.     IF (NameID>0) AND (FPID>0) AND (LPID>0) THEN
  454.     BEGIN
  455.       IF f.Open(Cfg.BBs.Path+fa^.Name,RecLen(fa),FALSE) THEN
  456.       BEGIN
  457.         RaAreaNUM := 0;
  458.         GetMem(Buf,RecLen(fa));
  459.         WHILE NOT f.EOF DO
  460.         BEGIN
  461.           f.Read(Buf^,nokeep,Wait);
  462.           NameStr:=GetFieldText(fa,NameID,Buf);
  463.           FilePathStr:=GetFieldText(fa,FPID,Buf);
  464.           ListPathStr:=GetFieldText(fa,LPID,Buf);
  465.           TagStr:=GetFieldText(fa,TagID,Buf);
  466.           { AN '95 }
  467.           INC(RaAreaNUM);
  468.           IF FdbPath <> '' THEN Tagstr := Long2str(RaAreanum); { hvis Ra2.x }
  469.           IF NameStr<> '' THEN AddToList(NameStr,FilePathStr,ListPathStr,TagStr);
  470.           WaitWin^.Animate;
  471.         END;
  472.         FreeMem(Buf,RecLen(fa));
  473.       END;
  474.       f.Close;
  475.     END;
  476.     DisposeFileStruct(fa);
  477.   END;
  478.   IF (io=0) AND (Cfg.AreaMan.AddInbound) THEN
  479.   BEGIN
  480.     AddToList('Your VERY OWN Unknown Inbound Directory ;-)',Cfg.Inbound[nsUnknown],'','997');
  481.     AddToList('Your VERY OWN Known Inbound Directory ;-)',Cfg.Inbound[nsKnown],'','998');
  482.     AddToList('Your VERY OWN Password Inbound Directory ;-)',Cfg.Inbound[nsPassword],'','999');
  483.   END;
  484.   Dispose(WaitWin, Done);
  485.   ReadFileAreas:=Num;
  486. END;
  487.  
  488.   FUNCTION HasFileName(CONST s: STRING): Boolean;
  489.   BEGIN
  490.     HasFileName:=((s<>'') AND NOT (s[1] IN [#0..#32,';','-','@','%','/']));
  491.   END;
  492.  
  493. {=== Download Counter manipulation ==========================================}
  494.  
  495.   FUNCTION MakeDlCnt(Num: LongInt): S10;
  496.   VAR
  497.     s : S10;
  498.   BEGIN
  499.     WITH Cfg.AreaMan DO
  500.     BEGIN
  501.       s:=DLCntStart+LeftPad(Long2Str(Num),DlCDigits)+DlCntStop;
  502.       IF DlCZeroFill THEN s:=Substitute(s, ' ', '0');
  503.     END;
  504.     MakeDlCnt:=s;
  505.   END;
  506.  
  507.   PROCEDURE AddDLC(VAR s: STRING);
  508.   VAR
  509.     Extra : S10;
  510.     Desc  : String;
  511.     i,j   : Byte;
  512.     Num   : LongInt;
  513.     Err   : Integer;
  514.   BEGIN
  515.     IF HasFileName(s) THEN
  516.     BEGIN
  517.       num:=0;
  518.       i:=Pos(' ',s);
  519.       IF i=0 THEN
  520.       BEGIN
  521.         s:=s+' '+MakeDlCnt(Num);
  522.       END ELSE
  523.       BEGIN
  524.         Desc:=Trim(Copy(s,i,255));
  525.         Extra:='';
  526.         IF Length(Desc)>=2 THEN
  527.         BEGIN
  528.           IF (Cfg.BBS.BBSType=btMax) AND (Copy(Desc,1,1)='/') THEN
  529.           BEGIN
  530.             j:=Pos(' ',Desc);
  531.             IF j>0 THEN
  532.             BEGIN
  533.               Extra:=Copy(Desc,1,j);
  534.               Delete(Desc,1,j);
  535.               Desc:=Trim(Desc);
  536.             END ELSE
  537.             BEGIN
  538.               Extra:=Desc+' ';
  539.               Desc:='';
  540.             END;
  541.           END;
  542.           j:=Pos(Cfg.AreaMan.DlCntStop, Desc);
  543.           IF (Copy(Desc,1,1)=Cfg.AreaMan.DlCntStart) AND (j>0) THEN
  544.           BEGIN
  545.             Val(Copy(Desc, 2, j-2), Num, Err);
  546.             IF Err<>0 THEN Num:=0;
  547.             Delete(Desc, 1, j);
  548.             Desc:=Trim(Desc);
  549.           END;
  550.         END;
  551.         s:=Pad(Copy(s,1,i),13)+Extra+MakeDlCnt(Num)+' '+Desc;
  552.       END;
  553.     END;
  554.   END;
  555.  
  556.   PROCEDURE DelDLC(VAR s: STRING);
  557.   VAR
  558.     Start,
  559.     Slut  : Byte;
  560.   BEGIN
  561.     IF HasFileName(s) THEN
  562.     BEGIN
  563.       AddDLC(s);
  564.       Start:=Pos(Cfg.AreaMan.DlCntStart, s);
  565.       Slut:=Pos(Cfg.AreaMan.DlCntStop, s);
  566.       IF (Slut<Length(s)) AND (s[Start-1]=' ') AND (s[Slut+1]=' ') THEN Inc(Slut);
  567.       Delete(s, Start, Slut-Start+1);
  568.     END;
  569.   END;
  570.  
  571.   PROCEDURE IncDLC(VAR s: STRING; Count: Byte);
  572.   VAR
  573.     Num   : LongInt;
  574.     Start,
  575.     Slut  : Byte;
  576.     Err   : Integer;
  577.   BEGIN
  578.     IF HasFileName(s) THEN
  579.     BEGIN
  580.       AddDLC(s);
  581.  
  582.       Start:=Pos(Cfg.AreaMan.DlCntStart, s);
  583.       Slut:=Pos(Cfg.AreaMan.DlCntStop, s);
  584.       Val(Trim(Copy(s, Start+1, Slut-Start-1)), Num, Err);
  585.       IF Err=0 THEN
  586.         s:=Copy(s, 1, Start-1)+MakeDlCnt(Num+Count)+Copy(s, Slut+1, 255);
  587.     END;
  588.   END;
  589.  
  590.   PROCEDURE ZeroDLC(VAR s: STRING);
  591.   BEGIN
  592.     IF HasFileName(s) THEN
  593.     BEGIN
  594.       DelDLC(s);
  595.       AddDLC(s);
  596.     END;
  597.   END;
  598.  
  599.   FUNCTION  GetDLC(s: STRING): LongInt;
  600.   VAR
  601.     Num   : LongInt;
  602.     Start,
  603.     Slut  : Byte;
  604.     Err   : Integer;
  605.   BEGIN
  606.     Num:=0;
  607.     IF HasFileName(s) THEN
  608.     BEGIN
  609.       AddDLC(s);
  610.       Start:=Pos(Cfg.AreaMan.DlCntStart, s);
  611.       Slut:=Pos(Cfg.AreaMan.DlCntStop, s);
  612.       Val(Trim(Copy(s, Start+1, Slut-Start-1)), Num, Err);
  613.       IF Err<>0 THEN Num:=0;
  614.     END;
  615.     GetDLC:=Num;
  616.   END;
  617.  
  618. END.
  619.